home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlIncludes.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  25.6 KB  |  667 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlIncludes.tcl"
  6.  #                                    created: 99-07-20 18.23.04 
  7.  #                                last update: 00-12-30 23.47.36 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains procs for the Includes submenu.
  35. #===============================================================================
  36.  
  37. #===============================================================================
  38. # ◊◊◊◊ Includes ◊◊◊◊ #
  39. #===============================================================================
  40. proc html::ConvertInclPath {fil path win} {
  41.     global file::separator
  42.     if {$path != "" && [string match "${path}*" $fil]} {
  43.         return "[html::SetCase INCLPATH=]\"[html::Quote [string range $fil [expr {[string length $path] + 1}] end]]\""
  44.     } else {
  45.         set fromdir [split [file dirname $win] ${file::separator}]
  46.         set todir [split $fil ${file::separator}]
  47.         
  48.         # Remove the common path.
  49.         set i 0
  50.         while {[llength $fromdir] > $i && [llength $todir] > $i \
  51.         && [lindex $fromdir $i] == [lindex $todir $i]} {
  52.             incr i
  53.         }
  54.     
  55.         # No common path?
  56.         if {!$i} {
  57.             return "[html::SetCase FILE=]\"[html::Quote $fil]\""
  58.         }
  59.         # Insert :
  60.         foreach f [lrange $fromdir $i end] {
  61.             append linkTo ":"
  62.         }
  63.         # Add the path.
  64.         append linkTo [join [lrange $todir $i end] ${file::separator}]
  65.         return "[html::SetCase PATH=]\"[html::Quote $linkTo]\""
  66.     }
  67. }
  68.  
  69. proc html::ResolveInclPath {fil folder basefldr} {
  70.     global file::separator tcl_platform
  71.     regexp {^([^=]+)="([^"]+)"} $fil "" type fil
  72.     set fil [html::UnQuote $fil]
  73.     switch [string toupper $type] {
  74.         FILE {
  75.             regsub -nocase {^:INCLUDE:} $fil "$folder${file::separator}" fil
  76.         }
  77.         INCLPATH {
  78.             set fil [file join $folder $fil]
  79.         }
  80.         PATH {
  81.             set colons 0
  82.             while {[string index $fil $colons] == ":"} {
  83.                 incr colons
  84.             }
  85.             if {$tcl_platform(platform) == "windows"} {
  86.                 regexp -nocase {([a-z]:/)(.*)} $basefldr "" disk basefldr
  87.             }
  88.             set b [split $basefldr ${file::separator}]
  89.             if {$colons > [llength $b]} {error "File not found."}
  90.             set fil [eval file join [lrange $b 0 [expr {[llength $b] - $colons - 1}]] \
  91.               [list [string trimleft $fil :]]]
  92.             if {$tcl_platform(platform) == "windows"} {set fil "$disk$fil"}
  93.         }
  94.     }
  95.     if {$tcl_platform(platform) == "unix"} {
  96.         return /$fil
  97.     } else {
  98.         return $fil
  99.     }
  100. }
  101.  
  102.  
  103. proc html::PasteIncludeTags {} {
  104.     global html::HomePageWinURL
  105.     if {![info exists html::HomePageWinURL]} {message "No file to paste."; return}
  106.     html::InsertIncludeTags ${html::HomePageWinURL}
  107. }
  108.  
  109. # Inserts new include tags at the current position.
  110. proc html::InsertIncludeTags {{fil ""}} {
  111.     global HTMLmodeVars
  112.     set win [html::StrippedFrontWindowPath]
  113.     if {![file exists $win]} {
  114.         if {[lindex [dialog -w 400 -h 80 \
  115.           -t "You must save the window before inserting include tags." 10 10 390 40  \
  116.           -b Save 20 50  85 70 \
  117.           -b Cancel 110 50 175 70] 1]} {
  118.             return
  119.         }
  120.         saveAs
  121.     }
  122.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  123.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  124.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $sexpr [getPos]} res] &&
  125.         ([catch {search -s -f 0 -r 1 -i 1 -m 0 $eexpr [getPos]} res1]
  126.         || [lindex $res 0] > [lindex $res1 0])} {
  127.         alertnote "Current position is inside an include container."
  128.         return
  129.     }
  130.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [getPos]} res] &&
  131.         ([catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [getPos]} res1]
  132.         || [lindex $res 0] < [lindex $res1 0])} {
  133.         alertnote "Current position is inside an include container."
  134.         return
  135.     }
  136.     set incl [html::WhichInclFolder [set win [html::StrippedFrontWindowPath]]]
  137.     if {$fil == "" && [catch {getfile "Select file to include." [file join $incl " "]} fil]} {return}
  138.     if {![html::IsTextFile $fil alertnote]} {return}
  139.     set fil1 [html::ConvertInclPath $fil $incl $win]
  140.     set text "<!-- [html::SetCase {#INCLUDE }]$fil1 -->\r\r"
  141.     if {$HTMLmodeVars(includeOnlyTags)} {append text "<B>The file [file tail $fil1] will be inserted here when the window is updated.</B>"}
  142.     append text "\r\r" "<!-- [html::SetCase /#INCLUDE] -->"
  143.     insertText [html::OpenCR 1] $text "\r\r"
  144.     if {!$HTMLmodeVars(includeOnlyTags)} {html::UpdateWindow $fil1}
  145. }
  146.  
  147. # Updates the text between all include tags.
  148. proc html::UpdateWindow {{fil ""}} {
  149.     set win [html::StrippedFrontWindowPath]
  150.     if {![file exists $win]} {
  151.         if {[lindex [dialog -w 400 -h 80 \
  152.           -t "You must save the window before updating." 10 10 390 40  \
  153.           -b Save 20 50  85 70 \
  154.           -b Cancel 110 50 175 70] 1]} {
  155.             return
  156.         }
  157.         saveAs
  158.     }
  159.     html::UpdateInclude Window $fil
  160. }
  161.  
  162. proc html::UpdateHomePage {} {html::UpdateInclude "Home page"}
  163. proc html::UpdateFolder {} {html::UpdateInclude Folder}
  164. proc html::UpdateFile {} {html::UpdateInclude File}
  165.  
  166. proc html::UpdateInclude {where {onlyThis ""}} {
  167.     global HTMLmodeVars html::TmpFolder htmlUpdateErr htmlUpdateList htmlUpdateBase htmlUpdatePath htmlUpdateHome 
  168.     global tileLeft tileTop tileWidth errorHeight file::separator
  169.     # Clean up after previous update
  170.     if {[file exists [file join ${html::TmpFolder} incl]]} {catch {rm -r [file join ${html::TmpFolder} incl]}}
  171.     if {[file exists [file join ${html::TmpFolder} xincl]]} {catch {rm -r [file join ${html::TmpFolder} xincl]}}
  172.     
  173.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  174.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  175.     set expBase "<(base\[ \\t\\n\\r\]+)\[^>\]*>"
  176.     set expBase2 "(href\[ \\t\\n\\r\]*=\[ \\t\\n\\r\]*)(\"\[^\"\]+\"|'\[^'\]+'|\[^ \\t\\n\\r>\]+)"
  177.     set htmlUpdateErr ""
  178.     if {$where == "Window"} {
  179.         set wname [html::StrippedFrontWindowPath]
  180.         set htmlUpdateList $wname
  181.         set inclFldr [html::WhichInclFolder $wname]
  182.         set home [html::WhichHomeFolder $wname]
  183.         if {$home != ""} {
  184.             set htmlUpdateBase [lindex $home 1]
  185.             set htmlUpdatePath [lindex $home 2]
  186.             set htmlUpdateHome [list [lindex $home 1] [lindex $home 2]]
  187.             regsub -all ${file::separator} [string range $wname [expr {[string length [lindex $home 0]] + 1}] end] / tp
  188.             append htmlUpdatePath [string range $tp 0 [string last / $tp]]
  189.         } else {
  190.             set htmlUpdateHome [list [set htmlUpdateBase "file:///"] ""]
  191.             regsub -all ${file::separator} [file dirname $wname] / htmlUpdatePath
  192.             append htmlUpdatePath /
  193.         }
  194.         set hasBase 0
  195.         if {![catch {search -s -f 1 -i 1 -m 0 -r 1 $expBase [minPos]} this]} {
  196.             set preBase [lindex $this 0]
  197.             set comm 0
  198.             set spos [minPos]
  199.             while {![catch {search -s -f 1 -i 1 -m 0 -l $preBase {<!--} $spos} bCom]} {
  200.                 set spos [lindex $bCom 1]
  201.                 set comm 1
  202.                 if {![catch {search -s -f 1 -i 1 -m 0 -l $preBase -- {-->} $spos} bCom]} {
  203.                     set spos [lindex $bCom 1]
  204.                     set comm 0
  205.                 } else {
  206.                     break
  207.                 }
  208.             }
  209.             if {!$comm && [regexp -nocase $expBase2 [getText [lindex $this 0] [lindex $this 1]] d1 d2 url1]} {
  210.                 set url1 [string trim $url1 {"'}]
  211.                 set hasBase 1
  212.             }
  213.         }
  214.         if {$hasBase && ![catch {html::BASEpieces $url1} basestr]} {
  215.             set htmlUpdateBase [lindex $basestr 0]
  216.             set tp [lindex $basestr 2]
  217.             set htmlUpdatePath "[lindex $basestr 1][string range $tp 0 [string last / $tp]]"
  218.         }
  219.         set pos [minPos]
  220.         while {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr $pos} res]} {
  221.             set lnum [lindex [posToRowCol [lindex $res 0]] 0]
  222.             set ln [expr {5 - [string length $lnum]}]
  223.             if {[catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [lindex $res 1]} res1]} {
  224.                 append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]Opening include tag without a matching end tag."\
  225.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  226.                 break
  227.             }
  228.             if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [lindex $res 1]} res2]
  229.             && [lindex $res2 0] < [lindex $res1 0]} {
  230.                 append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]Nested include tags."\
  231.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  232.                 set pos [lindex $res1 1]
  233.                 continue
  234.             }    
  235.             if {[catch {html::ReadInclude [eval getText $res] 1 [file dirname $wname] $inclFldr 0 $onlyThis} text]} {
  236.                 if {$text != "Not this file"} {append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]$text"\
  237.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"}
  238.                 set pos [lindex $res1 1]
  239.             } else {
  240.                 replaceText [lindex $res 1] [lindex $res1 0] "\r\r" $text "\r\r"
  241.                 set pos [pos::math [lindex $res 1] + [string length $text] + 4]
  242.             }
  243.         }
  244.     } else {
  245.         if {[html::AllSaved "-c {Save all open windows before updating?}"] == "cancel"} {return}
  246.         if {$where == "File"} {
  247.             if {[catch {getfile "Select file to update."} files]} {return}
  248.             if {![html::IsTextFile $files alertnote]} {return}
  249.             set inclFldr [html::WhichInclFolder $files]
  250.             set home [html::WhichHomeFolder $files]
  251.             set folder [file dirname $files]
  252.             set filelist [html::OpenAfile]
  253.             puts [lindex $filelist 0] $files
  254.             close [lindex $filelist 0]
  255.             set files [lindex $filelist 1]
  256.         } elseif {$where == "Folder"} {
  257.             if {[catch {html::GetDir "Update folder:"} folder]} {return}
  258.             set inclFldr [html::WhichInclFolder ${folder}]
  259.             set home [html::WhichHomeFolder ${folder}]
  260.             set subFolders [expr {![string compare yes [askyesno "Update files in subfolders?"]]}]
  261.             if {$subFolders} {
  262.                 set files [html::AllHTMLfiles $folder]
  263.             } else {
  264.                 set files [html::GetHTMLfiles $folder]
  265.             }
  266.         } else {
  267.             if {![html::IsThereAHomePage] ||
  268.             [catch {html::WhichHomePage "update"} home]} {return}
  269.             set folder [lindex $home 0]
  270.             set inclFldr [html::WhichInclFolder ${folder}]
  271.             set files [html::AllHTMLfiles $folder]
  272.         }
  273.         set fid0 [open $files]
  274.         while {![eof $fid0]} {
  275.             gets $fid0 f
  276.             if {$f == "" || [catch {open $f} fid1]} {continue}
  277.             set filecont [read $fid1 16384]
  278.             close $fid1
  279.             if {$home != ""} {
  280.                 set htmlUpdateBase [lindex $home 1]
  281.                 set htmlUpdatePath [lindex $home 2]
  282.                 set htmlUpdateHome [list [lindex $home 1] [lindex $home 2]]
  283.                 regsub -all ${file::separator} [string range $f [expr {[string length [lindex $home 0]] + 1}] end] / tp
  284.                 append htmlUpdatePath [string range $tp 0 [string last / $tp]]
  285.             } else {
  286.                 set htmlUpdateHome [list [set htmlUpdateBase "file:///"] ""]
  287.                 regsub -all ${file::separator} [file dirname $f] / htmlUpdatePath
  288.                 append htmlUpdatePath /
  289.             }
  290.             set hasBase 0
  291.             if {[regexp -nocase -indices $expBase $filecont this]} {
  292.                 set preBase [string range $filecont 0 [lindex $this 0]]
  293.                 set comm 0
  294.                 while {[regexp -indices {<!--} $preBase bCom]} {
  295.                     set preBase [string range $preBase [expr {[lindex $bCom 1] - 1}] end]
  296.                     set comm 1
  297.                     if {[regexp -indices -- {-->} $preBase bCom]} {
  298.                         set preBase [string range $preBase [expr {[lindex $bCom 1] - 1}] end]
  299.                         set comm 0
  300.                     } else {
  301.                         break
  302.                     }
  303.                 }
  304.                 if {!$comm && [regexp -nocase $expBase2 [string range $filecont [lindex $this 0] [lindex $this 1]] d1 d2 url1]} {
  305.                     set url1 [string trim $url1 {"'}]
  306.                     set hasBase 1
  307.                 }
  308.             }
  309.             if {$hasBase && ![catch {html::BASEpieces $url1} basestr]} {
  310.                 set htmlUpdateBase [lindex $basestr 0]
  311.                 set tp [lindex $basestr 2]
  312.                 set htmlUpdatePath "[lindex $basestr 1][string range $tp 0 [string last / $tp]]"
  313.             }
  314.             set htmlUpdateList $f
  315.             if {[html::UpdateOneFile $f $f $folder $inclFldr 0]} {lappend modified $f}
  316.         }
  317.         close $fid0
  318.         catch {file delete $files}
  319.     }
  320.     if {$htmlUpdateErr != ""} {
  321.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  322.         set name [lindex [winNames] 0]
  323.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  324.         insertText $htmlUpdateErr
  325.         html::SetWin
  326.     }
  327.     if {[info exists modified]} {
  328.         foreach w [html::AllWindowPaths] {
  329.             if {[lcontains modified [stripNameCount $w]]} {
  330.                 foreach ww [html::AllWindowPaths] {
  331.                     if {[lcontains modified [stripNameCount $ww]]} {
  332.                         bringToFront $ww
  333.                         revert
  334.                     }
  335.                 }
  336.                 if {$htmlUpdateErr != ""} {bringToFront $name}
  337.                 break
  338.             }
  339.         }
  340.     }
  341.     # Clean up
  342.     if {[file exists [file join ${html::TmpFolder} incl]]} {rm -r [file join ${html::TmpFolder} incl]}
  343.     if {[file exists [file join ${html::TmpFolder} xincl]]} {rm -r [file join ${html::TmpFolder} xincl]}
  344.     if {$htmlUpdateErr == ""} {message "$where updated successfully."}
  345.     unset htmlUpdateErr htmlUpdateList htmlUpdateBase htmlUpdatePath
  346. }
  347.  
  348. proc html::UpdateOneFile {f f1 folder inclFldr depth} {
  349.     global htmlUpdateErr htmlUpdateBase htmlUpdatePath htmlUpdateHome html::TmpFolder
  350.     if {[catch {open $f1} fid]} {return 0}
  351.     message "Updating [file tail $f1]…"
  352.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  353.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  354.     set exprr1 "<!--|\[ \\t\\n\\r\]+[html::URLregexp]"
  355.     set exprr2 {/\*|[ \t\r\n]+(url)\([ \t\r\n]*("[^"]+"|'[^']+'|[^ \t\n\r\)]+)[ \t\r\n]*\)}
  356.     set commStart1 "<!--"
  357.     set commEnd1 "-->"
  358.     set commStart2 {/*}
  359.     set commEnd2 {\*/}
  360.     getFileInfo $f1 finfo
  361.     if {!$depth} {set created $finfo(created)}
  362.     set filecont [read $fid 16384]
  363.     set limit [expr {[eof $fid] ? 0 : 300}]
  364.     regsub -all "\n\r" $filecont "\r" filecont
  365.     if {[regexp {\n} $filecont]} {
  366.         set newln "\n"
  367.     } else {
  368.         set newln "\r"
  369.     }
  370.     set linenum 1
  371.     set ismod 0
  372.     set errf [string range $f [expr {[string length $folder] + 1}] end]
  373.     set temp [html::OpenAfile]
  374.     set tmpfid [lindex $temp 0]
  375.     if {$depth} {puts $tmpfid "$htmlUpdateBase$htmlUpdatePath"}
  376.     set opening 0
  377.     set l [expr {20 - [string length [file tail $f]]}]
  378.     while {1} {
  379.         while {$opening || ([regexp -nocase -indices $sexpr $filecont res] && 
  380.         [expr {[string length $filecont] - [lindex $res 0]}] > $limit)} {
  381.             if {!$opening} {
  382.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res 0]] {} dummy]
  383.                 set ln [expr {5 - [string length $linenum]}]
  384.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res 1]]
  385.                 set readName [string range $filecont [lindex $res 0] [lindex $res 1]]
  386.                 set filecont [string range $filecont [expr {[lindex $res 1] + 1}] end]
  387.             }
  388.             if {![regexp -nocase -indices $eexpr $filecont res1] ||
  389.             [expr {[string length $filecont] - [lindex $res1 0]}] <= $limit} {
  390.                 if {[eof $fid]} {
  391.                     append htmlUpdateErr [html::BrwsErr $errf $l $linenum $ln "Opening include tag without a matching end tag." $f]
  392.                 } else {
  393.                     set opening 1
  394.                 }
  395.                 break
  396.             }
  397.             set toReplace [string trim [string range $filecont 0 [expr {[lindex $res1 0] - 1}]]]
  398.             set opening 0
  399.             if {[regexp -nocase -indices $sexpr $filecont res2]
  400.             && [lindex $res2 0] < [lindex $res1 0]} {
  401.                 append htmlUpdateErr [html::BrwsErr $errf $l $linenum $ln "Nested include tags." $f]
  402.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res1 1]]
  403.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  404.                 set filecont [string range $filecont [expr {[lindex $res1 1] + 1}] end]
  405.                 continue
  406.             }
  407.             if {[catch {html::ReadInclude $readName 0 [file dirname $f1] $inclFldr $depth} text]} {
  408.                 append htmlUpdateErr [html::BrwsErr $errf $l $linenum $ln $text $f]
  409.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res1 1]]                    
  410.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  411.                 set filecont [string range $filecont [expr {[lindex $res1 1] + 1}] end]
  412.                 continue
  413.             }
  414.             if {[string trim $text] != $toReplace} {
  415.                 set ismod 1
  416.             }
  417.             puts -nonewline $tmpfid "$newln$newln$text$newln$newln"
  418.             puts -nonewline $tmpfid [string range $filecont [lindex $res1 0] [lindex $res1 1]]
  419.             incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  420.             set filecont [string range $filecont [expr {[lindex $res1 1] + 1}] end]
  421.         }
  422.         if {![eof $fid]} {
  423.             if {$opening} {
  424.                 append filecont [read $fid 16384]
  425.             } else {
  426.                 puts -nonewline $tmpfid [string range $filecont 0 [expr {[string length $filecont] - 301}]]
  427.                 incr linenum [regsub -all $newln [string range $filecont 0 [expr {[string length $filecont] - 301}]] {} dummy]
  428.                 set filecont "[string range $filecont [expr {[string length $filecont] - 300}] end][read $fid 16384]"
  429.             }
  430.             set limit [expr {[eof $fid] ? 0 : 300}] 
  431.         } else {
  432.             break
  433.         }                    
  434.     }
  435.     close $fid
  436.     if {$ismod || $depth} {puts -nonewline $tmpfid $filecont}
  437.     close $tmpfid
  438.     if {$ismod && !$depth} {
  439.         set linenum 1
  440.         set opening 0
  441.         set done 0
  442.         set fid [open [set temp1 [lindex $temp 1]]]
  443.         set filecont [read $fid 16384]
  444.         set limit [expr {[eof $fid] ? 0 : 300}]
  445.         set temp [html::OpenAfile]
  446.         set tmpfid [lindex $temp 0]
  447.         while {1} {
  448.             if {$opening || ([regexp -nocase -indices {<!--[ \t\r\n]+#LASTMODIFIED[ \t\r\n]+[^>]+>} $filecont res] &&
  449.             [expr {[string length $filecont] - [lindex $res 0]}] > $limit)} {
  450.                 if {!$opening} {
  451.                     incr linenum [regsub -all "\n" [string range $filecont 0 [lindex $res 0]] {} dummy]
  452.                     set ln [expr {5 - [string length $linenum]}]
  453.                     puts -nonewline $tmpfid [string range $filecont 0 [lindex $res 1]]
  454.                     set lastMod [string range $filecont [lindex $res 0] [lindex $res 1]]
  455.                     set filecont [string range $filecont [expr {[lindex $res 1] + 1}] end]
  456.                 }
  457.                 if {![regexp -nocase -indices {<!--[ \t\r\n]+/#LASTMODIFIED[ \t\r\n]+[^>]+>} $filecont res1] ||
  458.                 [expr {[string length $filecont] - [lindex $res1 0]}] <= $limit} {
  459.                     if {[eof $fid]} {
  460.                         append htmlUpdateErr [html::BrwsErr $errf $l $linenum $ln "Opening 'last modified' tag without a matching closing tag." $f]
  461.                     } else {
  462.                         set opening 1
  463.                     }
  464.                 } else {
  465.                     set str [html::GetLastMod $lastMod]
  466.                     set done 1
  467.                     if {$str == "0"} {
  468.                         append htmlUpdateErr [html::BrwsErr $errf $l $linenum $ln "Invalid 'last modified' tags." $f]
  469.                     } else {
  470.                         puts -nonewline $tmpfid "\r$str\r[string range $filecont [lindex $res1 0] end]"
  471.                         set filecont ""
  472.                     }
  473.                 }
  474.             }
  475.             if {![eof $fid] && !$done} {
  476.                 if {$opening} {
  477.                     append filecont [read $fid 16384]
  478.                 } else {
  479.                     puts -nonewline $tmpfid [string range $filecont 0 [expr {[string length $filecont] - 301}]]
  480.                     incr linenum [regsub -all "\n" [string range $filecont 0 [expr {[string length $filecont] - 301}]] {} dummy]
  481.                     set filecont "[string range $filecont [expr {[string length $filecont] - 300}] end][read $fid 16384]"
  482.                 }
  483.                 set limit [expr {[eof $fid] ? 0 : 300}] 
  484.             } else {
  485.                 break
  486.             }
  487.         }
  488.         puts -nonewline $tmpfid $filecont
  489.         while {![eof $fid]} {
  490.             puts -nonewline $tmpfid [read $fid 16384]
  491.         }
  492.         close $fid
  493.         close $tmpfid
  494.         if {[catch {file delete $f1}] && [file exists $f1]} {
  495.             append htmlUpdateErr "$errf[format "%$l\s" ""]; Could not write update to file. An error occurred.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  496.         } else {
  497.             catch {file copy [lindex $temp 1] $f1; setFileInfo $f1 created $created}
  498.         }
  499.         catch {file delete $temp1}
  500.     } elseif {$depth} {
  501. #         set actualPath [file join [html::InclGetBaseFolder [file dirname $f1]] [file tail $f1]]
  502. #         if {$htmlUpdateBase != "file:///" && [string match [file join ${html::TmpFolder} incl *] $f1] && $inclFldr != ""} {
  503. #             set actualPath [file join $inclFldr $actualPath]
  504. #         }
  505.         set fid [open [set temp1 [lindex $temp 1]]]
  506.         set filecont [read $fid 16384]
  507.         set limit [expr {[eof $fid] ? 0 : 300}]
  508.         set temp [html::OpenAfile]
  509.         set tempf [lindex $temp 1]
  510.         set tempfid [lindex $temp 0]
  511.         for {set i1 1} {$i1 < 3} {incr i1} {
  512.             if {$i1 == 2} {
  513.                 close $fid
  514.                 seek $tempfid 0
  515.                 set fid $tempfid
  516.                 set filecont [read $fid 16384]
  517.                 set limit [expr {[eof $fid] ? 0 : 300}]
  518.                 set temp [html::OpenAfile]
  519.                 set tempfid [lindex $temp 0]
  520.             }
  521.             set commStart [set commStart$i1]
  522.             set commEnd [set commEnd$i1]
  523.             set exprr [set exprr$i1]
  524.             set comment 0
  525.             while {1} {
  526.                 while {$comment || ([regexp -nocase -indices $exprr $filecont href b url] &&
  527.                 [expr {[string length $filecont] - [lindex $href 0]}] > $limit)} {
  528.                     # Comment?
  529.                     if {$comment || [string range $filecont [lindex $href 0] [lindex $href 1]] == $commStart} {
  530.                         if {$comment} {
  531.                             set href {0 0}
  532.                             set subcont $filecont
  533.                         } else {
  534.                             set subcont [string range $filecont [expr {[lindex $href 1] + 1}] end]
  535.                         }
  536.                         if {[regexp -indices -- $commEnd $subcont cend] &&
  537.                         [expr {[string length $subcont] - [lindex $cend 0]}] > $limit} {
  538.                             puts -nonewline $tempfid [string range $filecont 0 [expr {[lindex $href 1] + [lindex $cend 1] - 1}]]
  539.                             set filecont [string range $filecont [expr {[lindex $href 1] + [lindex $cend 1]}] end]
  540.                             set comment 0
  541.                             continue
  542.                         } else {
  543.                             set comment 1
  544.                             break
  545.                         }
  546.                     }
  547.                     set urltxt [string trim [string range $filecont [lindex $url 0] [lindex $url 1]] {"'}]
  548.                     set url2 [html::URLunEscape $urltxt]
  549.                     if {[regsub -nocase ":HOMEPAGE:" $url2 [lindex $htmlUpdateHome 1] url2]} {
  550.                         if {[lindex $htmlUpdateHome 0] == $htmlUpdateBase} {
  551.                             set newurl [html::RelativePath $htmlUpdatePath $url2]
  552.                         } else {
  553.                             set newurl "[lindex $htmlUpdateHome 0]$url2"
  554.                         }
  555.                         set newurl [html::URLescape2 $newurl]
  556.                     } else {
  557. #                         set aPath [html::BASEfromPath $actualPath]
  558. #                         if {[catch {eval html::PathToFile [lrange  $aPath 0 3] [list $url2]} aPath]} {
  559.                             set newurl $urltxt
  560. #                         } else {
  561. #                             set newlink [html::BASEfromPath [lindex $aPath 0]]
  562. #                             set anchor ""
  563. #                             regexp {[^#]*(#.*)} $url2 "" anchor
  564. #                             if {[lindex $newlink 0] == [lindex $htmlUpdateHome 0]} {
  565. #                                 set newurl [html::RelativePath $htmlUpdatePath "[lindex $newlink 1][lindex $newlink 2]"]$anchor
  566. #                             } else {
  567. #                                 set newurl [html::URLescape [join [lrange $newlink 0 2] ""]]$anchor
  568. #                             }
  569. #                         }
  570.                     }
  571.                     puts -nonewline $tempfid [string range $filecont 0 [expr {[lindex $url 0] - 1}]]
  572.                     puts -nonewline $tempfid "\"$newurl\""
  573.                     set filecont [string range $filecont [expr {[lindex $url 1] + 1}] end]
  574.                 }
  575.                 if {![eof $fid]} {
  576.                     puts -nonewline $tempfid [string range $filecont 0 [expr {[string length $filecont] - 301}]]
  577.                     set filecont "[string range $filecont [expr {[string length $filecont] - 300}] end][read $fid 16384]"
  578.                     set limit [expr {[eof $fid] ? 0 : 300}] 
  579.                 } else {
  580.                     break
  581.                 }
  582.             }
  583.             puts -nonewline $tempfid $filecont
  584.         }
  585.         close $fid
  586.         close $tempfid
  587.         if {[catch {file delete $f1}] && [file exists $f1]} {
  588.             append htmlUpdateErr "$errf[format "%$l\s" ""]; Could not write update to file. An error occurred.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  589.         } else {
  590.             catch {file copy [lindex $temp 1] $f1}
  591.         }
  592.         catch {file delete $temp1}
  593.     }
  594.     catch {file delete [lindex $temp 1]}
  595.     catch {file delete $tempf}
  596.     return $ismod
  597. }
  598.  
  599. # Read content of a file to be included.
  600. proc html::ReadInclude {incl nr basefldr fldr depth {onlyThis ""}} {
  601.     global html::TmpFolder htmlUpdateList file::separator tcl_platform
  602.     set htmlUpdateList [lrange $htmlUpdateList 0 $depth]
  603.     if {![regexp -nocase {(file|inclpath|path)=\"[^\"]+\"} $incl fil]} {
  604.         error "Invalid opening include tag."
  605.     }
  606.     if {$onlyThis != "" && $fil != $onlyThis} {error "Not this file"}
  607.     if {$depth == 10} {error "Too deep recursive includes."}
  608.     if {$fldr == "" && [regexp -nocase {^FILE=":INCLUDE:} $fil]} {error ":INCLUDE: doesn't map to a folder."}
  609.     set basefldr [html::InclGetBaseFolder $basefldr]
  610.     set fil [html::ResolveInclPath $fil $fldr $basefldr]
  611.     if {[lcontains htmlUpdateList $fil]} {error "Infinite loop of includes."}
  612.     if {![file exists $fil]} {
  613.         error "File not found."
  614.     }
  615.     lappend htmlUpdateList $fil
  616.     set fil0 $fil
  617.     if {$tcl_platform(platform) == "windows"} {regsub : $fil0 # fil0}
  618.     if {$fldr != "" && [string match "$fldr*" $fil]} {
  619.         set folder $fldr
  620.         set tmpfil [file join ${html::TmpFolder} incl [string trimleft [string range $fil0 [string length $fldr] end] ${file::separator}]]
  621.     } else {
  622.         set folder [file dirname $fil]
  623.         set tmpfil [file join ${html::TmpFolder} xincl [string trimleft $fil0 ${file::separator}]]
  624.     }
  625.     if {![file exists $tmpfil] || ![html::UpdateSameBase $tmpfil]} {
  626.         file::ensureDirExists [file dirname $tmpfil]
  627.         if {[file exists $tmpfil]} {catch {file delete $tmpfil}}
  628.         catch {file copy $fil $tmpfil}
  629.         html::UpdateOneFile $fil $tmpfil $folder [html::WhichInclFolder $fil] [incr depth]
  630.     }
  631.     if {[catch {open $tmpfil} fid]} {
  632.         error "Could not read file."
  633.     }
  634.     gets $fid
  635.     set text [read $fid]
  636.     close $fid
  637.     regsub -all "\n\r" $text "\r" text
  638.     if {$nr} {regsub -all "\n" $text "\r" text}
  639.     # Remove include tags from inserted text
  640.     regsub -all -nocase "<!--\[ \t\r\n\]+/?#INCLUDE\[ \t\r\n\]+\[^>\]+>" $text "" text
  641.     return $text
  642. }
  643.  
  644. proc html::UpdateSameBase {fil} {
  645.     global htmlUpdateBase htmlUpdatePath
  646.     if {[catch {open $fil} fid]} {return 0}
  647.     set l [gets $fid]
  648.     close $fid
  649.     if {$l == "$htmlUpdateBase$htmlUpdatePath"} {return 1}
  650.     return 0
  651. }
  652.  
  653. proc html::InclGetBaseFolder {basefldr} {
  654.     global html::TmpFolder tcl_platform
  655.     if {[string match [file join ${html::TmpFolder} incl *] $basefldr]} {
  656.         set basefldr [string range $basefldr [expr {[string length [file join ${html::TmpFolder} incl]] + 1}] end]
  657.         if {$tcl_platform(platform) == "unix"} {set basefldr "/$basefldr"}
  658.         if {$tcl_platform(platform) == "windows"} {regsub # $basefldr : basefldr}
  659.     }
  660.     if {[string match [file join ${html::TmpFolder} xincl *] $basefldr]} {
  661.         set basefldr [string range $basefldr [expr {[string length [file join ${html::TmpFolder} xincl]] + 1}] end]
  662.         if {$tcl_platform(platform) == "unix"} {set basefldr "/$basefldr"}
  663.         if {$tcl_platform(platform) == "windows"} {regsub # $basefldr : basefldr}
  664.     }
  665.     return $basefldr
  666. }
  667.